{
  Copyright 2012 Sergey Ostanin

  Licensed under the Apache License, Version 2.0 (the "License");
  you may not use this file except in compliance with the License.
  You may obtain a copy of the License at

      http://www.apache.org/licenses/LICENSE-2.0

  Unless required by applicable law or agreed to in writing, software
  distributed under the License is distributed on an "AS IS" BASIS,
  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
  See the License for the specific language governing permissions and
  limitations under the License.
}

unit TestSession;

interface

uses
  Classes, SysUtils, Controls, MiscUtils, Forms, Graphics, TestCore, Profile;

type
  TTestSessionItem = class
  private
    FAnswered: Boolean;
    FPartRight: Single; { -1 = unknown }
  public
    property Answered: Boolean read FAnswered write FAnswered;
    property PartRight: Single read FPartRight write FPartRight;
  end;
  TTestSessionItemList = TGenericObjectList<TTestSessionItem>;

  TTestSession = class
  private
    FItems: TTestSessionItemList;
    FEditableAnswers: Boolean;
    FBrowsableQuestions: Boolean;
    FTimeTotal: TDateTime; { -1 = unlimited }
    FPartRight: Single; { -1 = unknown }
    function GetAnswerCount: Integer;
    function GetItemCount: Integer;
    procedure CheckItemIndex(Index: Integer);
    function GetItems(Index: Integer): TTestSessionItem;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Add(Item: TTestSessionItem);

    property AnswerCount: Integer read GetAnswerCount;
    property BrowsableQuestions: Boolean read FBrowsableQuestions write FBrowsableQuestions;
    property EditableAnswers: Boolean read FEditableAnswers write FEditableAnswers;
    property ItemCount: Integer read GetItemCount;
    property Items[Index: Integer]: TTestSessionItem read GetItems;
    property PartRight: Single read FPartRight write FPartRight;
    property TimeTotal: TDateTime read FTimeTotal write FTimeTotal;
  end;

  TSessionSlot = class
  private
    FPartRight: Single; { -1 if no response is given }
    FUserAnswer: TResponse; { nil if no response is given }
    FEmptyAnswer: TResponse;
    FRightAnswer: TResponse;
    FWeight: Integer;
    FSourceQuestionIndex: Integer;
    procedure SetEmptyAnswer(Value: TResponse);
    procedure SetRightAnswer(Value: TResponse);
    procedure SetUserAnswer(Value: TResponse);
  public
    destructor Destroy; override;

    property EmptyAnswer: TResponse read FEmptyAnswer write SetEmptyAnswer;
    property PartRight: Single read FPartRight write FPartRight;
    property RightAnswer: TResponse read FRightAnswer write SetRightAnswer;
    property SourceQuestionIndex: Integer read FSourceQuestionIndex write FSourceQuestionIndex;
    property UserAnswer: TResponse read FUserAnswer write SetUserAnswer;
    property Weight: Integer read FWeight write FWeight;
  end;
  TSessionSlotList = TGenericObjectList<TSessionSlot>;

  TSessionOutcome = class
  private
    FSlots: TSessionSlotList;
    function GetSlotCount: Integer;
    function GetSlots(Index: Integer): TSessionSlot;
    function GetWeightRight: Double;
    function GetWeightTotal: Int64;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Add(Slot: TSessionSlot);

    property SlotCount: Integer read GetSlotCount;
    property Slots[Index: Integer]: TSessionSlot read GetSlots;
    property WeightRight: Double read GetWeightRight;
    property WeightTotal: Int64 read GetWeightTotal;
  end;

  TQuestionResult = class
  private
    FWeight: Integer;
    FPartRight: Single;
    FSectionIndex: Integer;
    FEmptyAnswer: TResponse;
    FUserAnswer: TResponse;
    FRightAnswer: TResponse;
    procedure SetEmptyAnswer(Value: TResponse);
    procedure SetRightAnswer(Value: TResponse);
    procedure SetUserAnswer(Value: TResponse);
  public
    destructor Destroy; override;

    property EmptyAnswer: TResponse read FEmptyAnswer write SetEmptyAnswer;
    property PartRight: Single read FPartRight write FPartRight;
    property RightAnswer: TResponse read FRightAnswer write SetRightAnswer;
    property SectionIndex: Integer read FSectionIndex write FSectionIndex;
    property UserAnswer: TResponse read FUserAnswer write SetUserAnswer;
    property Weight: Integer read FWeight write FWeight;
  end;
  TQuestionResultList = TGenericObjectList<TQuestionResult>;

  TSectionResult = class
  private
    FName: String;
    FPartRight: Single;
    FQuestionCount: Integer;
    FWeightRight: Double;
    FWeightTotal: Integer;
  public
    property Name: String read FName write FName;
    property PartRight: Single read FPartRight write FPartRight;
    property QuestionCount: Integer read FQuestionCount write FQuestionCount;
    property WeightRight: Double read FWeightRight write FWeightRight;
    property WeightTotal: Integer read FWeightTotal write FWeightTotal;
  end;
  TSectionResultList = TGenericObjectList<TSectionResult>;

  TSessionResult = class
  private
    FPartRight: Single;
    FMark: String;
    FQuestionCount: Integer;
    FWeightRight: Double;
    FWeightTotal: Integer;
    FQuestionResults: TQuestionResultList;
    FSectionResults: TSectionResultList;
    FPolicy: TResultPolicy;
    function GetSectionResults(Index: Integer): TSectionResult;
    function GetQuestionResults(Index: Integer): TQuestionResult;
    function GetQuestionResultCount: Integer;
    function GetSectionResultCount: Integer;
  public
    constructor Create;
    destructor Destroy; override;
    class function Generate(Test: TTest; Profile: TProfile;
      SessionOutcome: TSessionOutcome): TSessionResult;
    procedure AddQuestionResult(QuestionResult: TQuestionResult);
    procedure AddSectionResult(SectionResult: TSectionResult);
    procedure ClearQuestionResults;
    procedure ClearSectionResults;
    function IndexOfSectionResult(SectionResult: TSectionResult): Integer;

    property Mark: String read FMark write FMark;
    property PartRight: Single read FPartRight write FPartRight;
    property Policy: TResultPolicy read FPolicy;
    property QuestionCount: Integer read FQuestionCount write FQuestionCount;
    property QuestionResultCount: Integer read GetQuestionResultCount;
    property QuestionResults[Index: Integer]: TQuestionResult read GetQuestionResults;
    property SectionResultCount: Integer read GetSectionResultCount;
    property SectionResults[Index: Integer]: TSectionResult read GetSectionResults;
    property WeightRight: Double read FWeightRight write FWeightRight;
    property WeightTotal: Integer read FWeightTotal write FWeightTotal;
  end;

  TTestSessionConnector = class
  public
    function GetSession: TTestSession; virtual; abstract;
    procedure GetQuestions(Questions: TQuestionList); virtual; abstract;
    function FinishWork: TSessionResult; virtual; abstract;
    procedure SetResponse(Index: Integer; Response: TResponse;
      out PartRight, PartRightTotal: Single); virtual; abstract;
  end;

implementation

{ TTestSession }

procedure TTestSession.Add(Item: TTestSessionItem);
begin
  FItems.AddSafely(Item);
end;

procedure TTestSession.CheckItemIndex(Index: Integer);
begin
  Assert( Index >= 0 );
  Assert( Index < ItemCount );
end;

constructor TTestSession.Create;
begin
  inherited;
  FItems := TTestSessionItemList.Create;
end;

destructor TTestSession.Destroy;
begin
  FreeAndNil(FItems);
  inherited;
end;

function TTestSession.GetItemCount: Integer;
begin
  Result := FItems.Count;
end;

function TTestSession.GetAnswerCount: Integer;
var
  Item: TTestSessionItem;
begin
  Result := 0;
  for Item in FItems do
    if Item.FAnswered then
      Inc(Result);
end;

function TTestSession.GetItems(Index: Integer): TTestSessionItem;
begin
  CheckItemIndex(Index);
  Result := FItems[Index];
end;

{ TSessionResult }

procedure TSessionResult.AddQuestionResult(QuestionResult: TQuestionResult);
begin
  FQuestionResults.AddSafely(QuestionResult);
end;

procedure TSessionResult.AddSectionResult(SectionResult: TSectionResult);
begin
  FSectionResults.AddSafely(SectionResult);
end;

procedure TSessionResult.ClearQuestionResults;
begin
  FQuestionResults.Clear;
end;

procedure TSessionResult.ClearSectionResults;
begin
  FSectionResults.Clear;
end;

function TSessionResult.IndexOfSectionResult(SectionResult: TSectionResult): Integer;
begin
  Result := FSectionResults.IndexOf(SectionResult);
end;

constructor TSessionResult.Create;
begin
  inherited;
  FQuestionResults := TQuestionResultList.Create;
  FSectionResults := TSectionResultList.Create;
  FPolicy := TResultPolicy.Create;
end;

destructor TSessionResult.Destroy;
begin
  FreeAndNil(FQuestionResults);
  FreeAndNil(FSectionResults);
  FreeAndNil(FPolicy);
  inherited;
end;

class function TSessionResult.Generate(Test: TTest;
  Profile: TProfile; SessionOutcome: TSessionOutcome): TSessionResult;
var
  WeightTotal: Int64;
  WeightRight: Double;
  i, SectionIndex: Integer;
  Slot: TSessionSlot;
  AllSections: TSectionList;
  SectionResults: TSectionResultList;
  QuestionResult: TQuestionResult;
  SectionResult: TSectionResult;
  Section: TSection;
  AllQuestions: TQuestionList;
  SlotSectionResults: array of TSectionResult;
begin
  Result := TSessionResult.Create;
  try
    Result.Policy.Assign(Profile.ResultPolicy);

    if Result.Policy.ResultsAvailable then
    begin
      WeightTotal := SessionOutcome.WeightTotal;
      WeightRight := SessionOutcome.WeightRight;
      Assert( WeightTotal > 0 );

      Result.QuestionCount := SessionOutcome.SlotCount;
      if Result.Policy.Mark then
        Result.Mark := Profile.MarkScale.PartRightToMark(WeightRight / WeightTotal);
      if Result.Policy.Points then
      begin
        Result.WeightTotal := WeightTotal;
        Result.WeightRight := WeightRight;
      end;
      if Result.Policy.PercentCorrect then
        Result.PartRight := WeightRight / WeightTotal;

      if Result.Policy.QuestionResultsAvailable or Result.Policy.SectionResultsAvailable then
      begin
        AllSections := TSectionList.Create(FALSE);
        try
          Test.Section.GetChildSections(AllSections, TRUE);

          AllQuestions := TQuestionList.Create(FALSE);
          try
            Test.Section.GetCompleteQuestionList(AllQuestions);

            SectionResults := TSectionResultList.Create;
            try
              SectionResults.Count := AllSections.Count;
              SetLength(SlotSectionResults, SessionOutcome.SlotCount);

              for i := 0 to SessionOutcome.SlotCount-1 do
              begin
                Slot := SessionOutcome.Slots[i];

                QuestionResult := TQuestionResult.Create;
                Result.AddQuestionResult(QuestionResult);

                Assert( Slot.RightAnswer <> nil );
                QuestionResult.RightAnswer := Slot.RightAnswer.Clone;

                Assert( Slot.EmptyAnswer <> nil );
                QuestionResult.EmptyAnswer := Slot.EmptyAnswer.Clone;

                if Slot.UserAnswer <> nil then
                  QuestionResult.UserAnswer := Slot.UserAnswer.Clone;

                QuestionResult.Weight := Slot.Weight;
                QuestionResult.PartRight := Slot.PartRight;

                Section := AllQuestions[Slot.SourceQuestionIndex].Section;
                SectionIndex := AllSections.IndexOf(Section);
                Assert( SectionIndex <> -1 );

                if SectionResults[SectionIndex] = nil then
                begin
                  SectionResults[SectionIndex] := TSectionResult.Create;
                  SectionResults[SectionIndex].Name := Section.Name;
                end;

                SectionResult := SectionResults[SectionIndex];
                SectionResult.QuestionCount := SectionResult.QuestionCount + 1;
                SectionResult.WeightTotal := SectionResult.WeightTotal + QuestionResult.Weight;
                if QuestionResult.UserAnswer <> nil then
                  SectionResult.WeightRight := SectionResult.WeightRight
                    + QuestionResult.Weight * QuestionResult.PartRight;

                SlotSectionResults[i] := SectionResult;
              end;

              for i := 0 to SectionResults.Count-1 do
              begin
                SectionResult := SectionResults[i];
                if SectionResult <> nil then
                begin
                  SectionResults.FreeObjects := FALSE;
                  SectionResults[i] := nil;
                  SectionResults.FreeObjects := TRUE;
                  Result.AddSectionResult(SectionResult);

                  Assert( SectionResult.WeightTotal > 0 );
                  SectionResult.PartRight := SectionResult.WeightRight / SectionResult.WeightTotal;
                end;
              end;
            finally
              SectionResults.Free;
            end;
          finally
            AllQuestions.Free;
          end;
        finally
          AllSections.Free;
        end;

        for i := 0 to Result.QuestionResultCount-1 do
        begin
          QuestionResult := Result.QuestionResults[i];
          QuestionResult.SectionIndex := Result.IndexOfSectionResult(SlotSectionResults[i]);
          Assert( QuestionResult.SectionIndex <> -1 );
        end;

        if Result.Policy.QuestionResultsAvailable then
        begin
          for i := 0 to Result.QuestionResultCount-1 do
          begin
            QuestionResult := Result.QuestionResults[i];
            if not Result.Policy.QuestionPercentCorrect then
              QuestionResult.PartRight := 0;
            if not Result.Policy.QuestionCorrectAnswer then
              QuestionResult.RightAnswer := nil;
            if not (Result.Policy.QuestionPoints or Profile.Configuration.WeightCues) then
              QuestionResult.Weight := 1;
            if not (Result.Policy.SectionResultsAvailable and Result.Policy.SectionQuestionList) then
              QuestionResult.SectionIndex := -1;
          end;
        end
        else
          Result.ClearQuestionResults;

        if Result.Policy.SectionResultsAvailable then
        begin
          for i := 0 to Result.SectionResultCount-1 do
          begin
            SectionResult := Result.SectionResults[i];
            if not Result.Policy.SectionPercentCorrect then
              SectionResult.PartRight := 0;
            if not Result.Policy.SectionPoints then
            begin
              SectionResult.WeightRight := 0;
              SectionResult.WeightTotal := 0;
            end;
            if not Result.Policy.SectionQuestionCount then
              SectionResult.QuestionCount := 0;
          end;
        end
        else
          Result.ClearSectionResults;
      end;
    end;
  except
    Result.Free;
    raise;
  end;
end;

function TSessionResult.GetQuestionResultCount: Integer;
begin
  Result := FQuestionResults.Count;
end;

function TSessionResult.GetQuestionResults(Index: Integer): TQuestionResult;
begin
  Result := FQuestionResults[Index];
end;

function TSessionResult.GetSectionResultCount: Integer;
begin
  Result := FSectionResults.Count;
end;

function TSessionResult.GetSectionResults(Index: Integer): TSectionResult;
begin
  Result := FSectionResults[Index];
end;

{ TQuestionResult }

destructor TQuestionResult.Destroy;
begin
  FreeAndNil(FEmptyAnswer);
  FreeAndNil(FUserAnswer);
  FreeAndNil(FRightAnswer);
  inherited;
end;

procedure TQuestionResult.SetEmptyAnswer(Value: TResponse);
begin
  if FEmptyAnswer <> Value then
  begin
    FreeAndNil(FEmptyAnswer);
    FEmptyAnswer := Value;
  end;
end;

procedure TQuestionResult.SetRightAnswer(Value: TResponse);
begin
  if FRightAnswer <> Value then
  begin
    FreeAndNil(FRightAnswer);
    FRightAnswer := Value;
  end;
end;

procedure TQuestionResult.SetUserAnswer(Value: TResponse);
begin
  if FUserAnswer <> Value then
  begin
    FreeAndNil(FUserAnswer);
    FUserAnswer := Value;
  end;
end;

{ TSessionOutcome }

procedure TSessionOutcome.Add(Slot: TSessionSlot);
begin
  FSlots.AddSafely(Slot);
end;

constructor TSessionOutcome.Create;
begin
  inherited;
  FSlots := TSessionSlotList.Create;
end;

destructor TSessionOutcome.Destroy;
begin
  FreeAndNil(FSlots);
  inherited;
end;

function TSessionOutcome.GetSlotCount: Integer;
begin
  Result := FSlots.Count;
end;

function TSessionOutcome.GetSlots(Index: Integer): TSessionSlot;
begin
  Assert( Index >= 0 );
  Assert( Index < SlotCount );
  Result := FSlots[Index];
end;

function TSessionOutcome.GetWeightRight: Double;
var
  Slot: TSessionSlot;
begin
  Result := 0;
  for Slot in FSlots do
    if Slot.PartRight <> -1 then
      Result := Result + Slot.PartRight*Slot.Weight;
end;

function TSessionOutcome.GetWeightTotal: Int64;
var
  Slot: TSessionSlot;
begin
  Result := 0;
  for Slot in FSlots do
    Result := Result + Slot.Weight;
end;

{ TSessionSlot }

destructor TSessionSlot.Destroy;
begin
  FreeAndNil(FUserAnswer);
  FreeAndNil(FEmptyAnswer);
  FreeAndNil(FRightAnswer);
  inherited;
end;

procedure TSessionSlot.SetEmptyAnswer(Value: TResponse);
begin
  if FEmptyAnswer <> Value then
  begin
    FreeAndNil(FEmptyAnswer);
    FEmptyAnswer := Value;
  end;
end;

procedure TSessionSlot.SetRightAnswer(Value: TResponse);
begin
  if FRightAnswer <> Value then
  begin
    FreeAndNil(FRightAnswer);
    FRightAnswer := Value;
  end;
end;

procedure TSessionSlot.SetUserAnswer(Value: TResponse);
begin
  if FUserAnswer <> Value then
  begin
    FreeAndNil(FUserAnswer);
    FUserAnswer := Value;
  end;
end;

end.
